home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 27.zip / BS1 part 27 / HiSoftBasicD2.adf / Dreier.bas < prev    next >
BASIC Source File  |  1989-05-18  |  4KB  |  138 lines
  1. '" dreierneu
  2. '" Demo schnelles Flächenfüllen
  3. '" P. Kittel, CBM Ffm, 4.4.87, 18.6.88
  4.  
  5. CLEAR,4000
  6. CLEAR,7500
  7.  
  8. sc&=PEEKL(WINDOW(7) + 46) '" Screen-Struktur
  9. Hoehe=PEEKW(sc&+14):PRINT '" Screen-Höhe
  10. IF Hoehe=256 THEN
  11.   ym=250:y1=140:y0=58:ye=119:zl=29:PRINT "PAL-Schirm"
  12.           ELSE
  13.   ym=200:y1=105:y0=45:ye= 93:zl=23:PRINT "NTSC-Schirm"
  14.   END IF
  15.  
  16. PRINT
  17. PRINT "Der Farbzyklus ist hier durch fz=0 (bzw. a$=";CHR$(34);"o";CHR$(34);")"
  18. PRINT "lahmgelegt, er ist nur bei Compilation"
  19. PRINT "sinnvoll, weil er sehr zeitaufwendig ist."
  20. a$="o"
  21. '" PRINT "Mit(m) oder ohne(o) Farbzyklus ? ";
  22. '" a$="":WHILE a$<>"m" AND a$<>"o":a$=INKEY$:WEND
  23. '" PRINT a$:PRINT 
  24. fz=a$="m"
  25.  
  26. SCREEN 1,570,ym,4,2
  27. WINDOW 2," Demo schnelles Füllen von Dreiecksflächen, Ende mit q ",(0,0)-(500,ym-15),0,1
  28. x1=250
  29. x2=290:y2=y1
  30. z1=0  :z2=0
  31. co=2
  32.  
  33. nn=15
  34. DIM pr(nn),pg(nn),pb(nn),pra(nn+1),pga(nn+1),pba(nn+1)
  35. FOR i=2 TO nn:PALETTE i,0,0,0:NEXT
  36. fr=0:fg=0:fb=0:pf=0:ff=4000:fs=0:c7=7/15:c6=15*16:c2=15*256
  37. cc=0:cf=1:co2=0
  38. PALETTE 0,.5,.5,.5
  39. COLOR 1
  40. LOCATE 1,2:PRINT "Schnelle";:   LOCATE 1   ,50:PRINT "Flächenfüllen";
  41. LOCATE 2,2:PRINT "Grafik"  ;:   LOCATE 2   ,52:PRINT "mit Blitter";
  42.                                 LOCATE zl-1,58:PRINT "Bitte";
  43.                                 LOCATE zl  ,51:PRINT "vergleichen!";
  44. IF fz THEN
  45.   LOCATE zl/2-1,25:PRINT "Bitte etwas Geduld...";
  46.   END IF
  47. COLOR 2
  48. LOCATE zl-1,2:PRINT "4096";
  49. LOCATE zl  ,2:PRINT "Farbtöne";
  50.  
  51. '" Die Art der Farbweiterschaltung wird
  52. '" durch die Variablen fs und ff in
  53. '" späteren Zeilen bestimmt.
  54. '" Hier ist viel Raum für eigene
  55. '" Experimente.
  56.  
  57. WHILE INKEY$<>"q" ' Endlosschleife bis q-Taste
  58.  
  59.   x3=x2 :y3=y2
  60.   z1=z1+.01         :IF z1>6.28 THEN z1=0
  61.   z2=z2+.03*SIN(z1) :IF z2>6.28 THEN z2=0
  62.   z3=z3+z1*SIN(z2)/4:IF z3>6.28 THEN z3=0
  63.  
  64.   x2=INT(120*(1+SIN(z2))*COS(z3)+x1)
  65.   y2=INT( y0*(1+SIN(z2))*SIN(z3)+ye)
  66.   AREA (x1,y1):AREA (x2,y2):AREA (x3,y3)
  67.  
  68.   IF fz=0 THEN
  69.     pra(co)=pr(co):pga(co)=pg(co):pba(co)=pb(co)
  70.     PALETTE co,pr(co),pg(co),pb(co)
  71.     END IF
  72.  
  73.   '" Farbweiterschaltung
  74.   co=co+1:IF co>nn THEN
  75.     co=2
  76.     co2=co2+1
  77.     IF co2>1 OR fz=0 THEN
  78.       co2=0
  79.       fs=fs+.1:IF fs>7 THEN fs=fs-7
  80.       ff=ff+273.16*(1+COS(fs)*1.02):IF ff>4095 THEN ff=ff-4095
  81.       fi=INT(ff)
  82.       ar=fr:ag=fg:ab=fb
  83.       fr=(fi AND 15)/15
  84.       fg=(fi AND 15*16 )/c6
  85.       fb=(fi AND 15*256)/c2  
  86.       pr(15)=fr:pg(15)=fg:pb(15)=fb ' neue Farbe
  87.       cc=cc+1:IF cc>20 THEN cc=0:cf=-cf
  88.       IF cf*(fr+ar)>cf THEN
  89.         fr2=2-fr:m=(fr2-ar)/14:a=ar-m
  90.         FOR i=2 TO 14:pr(i)=a+i*m:IF pr(i)>1 THEN pr(i)=2-pr(i)
  91.           NEXT
  92.               ELSE
  93.         fr2=-fr:m=(fr2-ar)/14:a=ar-m
  94.         FOR i=2 TO 14:pr(i)=a+i*m:IF pr(i)<0 THEN pr(i)=-pr(i)
  95.           NEXT
  96.         END IF
  97.       IF cf*(fg+ag)>cf THEN
  98.         fg2=2-fg:m=(fg2-ag)/14:a=ag-m
  99.         FOR i=2 TO 14:pg(i)=a+i*m:IF pg(i)>1 THEN pg(i)=2-pg(i)
  100.           NEXT
  101.               ELSE
  102.         fg2=-fg:m=(fg2-ag)/14:a=ag-m
  103.         FOR i=2 TO 14:pg(i)=a+i*m:IF pg(i)<0 THEN pg(i)=-pg(i)
  104.           NEXT
  105.         END IF
  106.       IF cf*(fb+ab)>cf THEN
  107.         fb2=2-fb:m=(fb2-ab)/14:a=ab-m
  108.         FOR i=2 TO 14:pb(i)=a+i*m:IF pb(i)>1 THEN pb(i)=2-pb(i)
  109.           NEXT
  110.               ELSE
  111.         fb2=-fb:m=(fb2-ab)/14:a=ab-m
  112.         FOR i=2 TO 14:pb(i)=a+i*m:IF pb(i)<0 THEN pb(i)=-pb(i)
  113.           NEXT
  114.         END IF
  115.       END IF
  116.     END IF
  117.  
  118.   IF fz THEN
  119.     '" Palette zyklisch umbelegen  
  120.      FOR i=nn+1 TO 3 STEP -1
  121.        pra(i)=pra(i-1): pga(i)=pga(i-1): pba(i)=pba(i-1)
  122.        NEXT
  123.      pra(2)=pra(nn+1): pga(2)=pga(nn+1): pba(2)=pba(nn+1)
  124.      cd=2*co-2: IF cd>nn THEN cd=cd-nn+1
  125.      pra(cd)=pr(co):   pga(cd)=pg(co):   pba(cd)=pb(co)
  126.      FOR i=2 TO nn:PALETTE i,pra(i),pga(i),pba(i):NEXT
  127.      END IF
  128.  
  129.   COLOR co
  130.   AREAFILL
  131.   WEND
  132.  
  133. '" Am Schluß sauber aufräumen
  134. WINDOW CLOSE 2
  135. SCREEN CLOSE 1
  136. END
  137.  
  138.